Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue27/system/UPeek2/PackPeek.pas

Pascal/Delphi Source File | 1997-10-02 | 5.3 KB | 196 lines

unit PackPeek;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    OpenDialog: TOpenDialog;
    CurrentFile: TLabel;
    Button1: TButton;
    Panel1: TPanel;
    MainUnit: TLabel;
    PackageUnit: TLabel;
    WeakPackageUnit: TLabel;
    ImplicitImport: TLabel;
    Label1: TLabel;
    UnitList: TListBox;
    Panel2: TPanel;
    PackageList: TListBox;
    Label2: TLabel;
    Panel3: TPanel;
    NeverBuild: TLabel;
    DesignTime: TLabel;
    RunTime: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure UnitListClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function FormatPathToFit (const fName: String; Canvas: TCanvas; AvailWidth: Integer): String;
var
    Idx: Integer;
    Drive: String[4];
    Path, Name, Ext: String;

    procedure ShortenPath;
    var
        StartSlash: Boolean;
    begin
        if Path = '\' then Path := '' else begin
            if Path[1] = '\' then begin
                StartSlash := True;
                Path := Copy (Path, 2, 255);
            end
            else StartSlash := False;

            if Path[1] = '.' then Path := Copy (Path, 5, 255);

            Idx := Pos ('\', Path);
            if Idx <> 0 then Path := '...\' + Copy (Path, Idx + 1, 255)
            else Path := '';

            if StartSlash then Path := '\' + Path;
        end;
    end;

begin
    Result := fName;
    Path := ExtractFilePath (Result);
    Name := ExtractFileName (Result);
    Idx := Pos ('.', Name);
    if Idx > 0 then SetLength (Name, Idx - 1);
    Ext := ExtractFileExt (Result);
    if Path [2] = ':' then begin
        Drive := Copy (Path, 1, 2);
        Path := Copy (Path, 3, 255);
    end
    else Drive := '';

    while ((Path <> '') or (Drive <> '')) and (Canvas.TextWidth (Result) > AvailWidth) do
    begin
        if Path = '\...\' then begin
            Drive := '';
            Path := '...\';
        end
        else if Path = '' then Drive := ''
        else ShortenPath;

        Result := Drive + Path + Name + Ext;
    end;
end;

function BoolCaption (Flags, Mask: Byte; const RootCaption: ShortString): ShortString;
begin
    Result := RootCaption + ': ';
    if (Flags and Mask) <> 0 then Result := Result + 'Yes'
    else Result := Result + 'No';
end;

procedure TForm1.Button1Click (Sender: TObject);
var
    hLib: hModule;
    rs: TResourceStream;
    UnitFlags: Byte;
    Idx, PackageFlags, ContainsCount, RequiresCount: Integer;

    function rsReadByte: Byte;
    begin
        rs.Read (Result, sizeof (Result));
    end;

    function rsReadInteger: Integer;
    begin
        rs.Read (Result, sizeof (Result));
    end;

    function rsReadString: ShortString;
    var
        Ch: Char;
    begin
        Result := '';
        repeat
            Ch := Char (rsReadByte);
            if Ch <> #0 then Result := Result + Ch;
        until Ch = #0;
    end;

begin
    if OpenDialog.Execute then begin
        UnitList.Clear;
        PackageList.Clear;
        CurrentFile.Caption := FormatPathToFit (OpenDialog.FileName, Canvas, CurrentFile.Width);
        hLib := LoadLibrary (PChar (OpenDialog.FileName));
        if hLib <> 0 then try
            { If we get here, it's a 32-bit executable }
            try
                rs := TResourceStream.Create (hLib, 'PACKAGEINFO', rt_rCData);
            except
                { If executable has no PackageInfo resource, just bow out }
                Exit;
            end;

            { Ok, we've got the resource stream - now interpret the data }

            PackageFlags := rsReadInteger;
            NeverBuild.Caption := BoolCaption (PackageFlags, 1, 'Never-Build');
            DesignTime.Caption := BoolCaption (PackageFlags, 2, 'Design-Time');
            RunTime.Caption := BoolCaption (PackageFlags, 4, 'Run-Time');

            RequiresCount := rsReadInteger;
            if RequiresCount <> 0 then
                for Idx := 0 to RequiresCount - 1 do begin
                    rsReadByte;
                    PackageList.Items.Add (rsReadString);
                end;

            ContainsCount := rsReadInteger;
            if ContainsCount <> 0 then begin
                for Idx := 0 to ContainsCount - 1 do begin
                    UnitFlags := rsReadByte;
                    rsReadByte;
                    UnitList.Items.AddObject (rsReadString, TObject (UnitFlags));
                end;

                UnitList.ItemIndex := 0;
                UnitListClick (Self);
            end;

            rs.Free;
        finally
            FreeLibrary (hLib);
        end;
    end;
end;

procedure TForm1.UnitListClick(Sender: TObject);
var
    Flags: Byte;

begin
    if UnitList.ItemIndex <> -1 then begin
        Flags := Byte (UnitList.Items.Objects [UnitList.ItemIndex]);

        MainUnit.Caption := BoolCaption (Flags, 1, 'Main Unit');
        PackageUnit.Caption := BoolCaption (Flags, 2, 'Package unit (DPK source)');
        WeakpackageUnit.Caption := BoolCaption (Flags, 4, '$WEAKPACKAGE directive');
        ImplicitImport.Caption := BoolCaption (Flags, 16, 'Implicitly Imported');
    end;
end;

end.